home *** CD-ROM | disk | FTP | other *** search
/ PC User 2003 January / Disc 3 / Amethyst.iso / live / usr / bin / strace-graph < prev    next >
Encoding:
Text File  |  2001-03-10  |  8.1 KB  |  340 lines
  1. #!/usr/bin/perl
  2.  
  3. # This script processes strace -f output.  It displays a graph of invoked
  4. # subprocesses, and is useful for finding out what complex commands do.
  5.  
  6. # You will probably want to invoke strace with -q as well, and with
  7. # -s 100 to get complete filenames.
  8.  
  9. # The script can also handle the output with strace -t, -tt, or -ttt.
  10. # It will add elapsed time for each process in that case.
  11.  
  12. # This script is Copyright (C) 1998 by Richard Braakman <dark@xs4all.nl>.
  13.  
  14. # Redistribution and use in source and binary forms, with or without
  15. # modification, are permitted provided that the following conditions
  16. # are met:
  17. # 1. Redistributions of source code must retain the above copyright
  18. #    notice, this list of conditions and the following disclaimer.
  19. # 2. Redistributions in binary form must reproduce the above copyright
  20. #    notice, this list of conditions and the following disclaimer in the
  21. #    documentation and/or other materials provided with the distribution.
  22. # 3. The name of the author may not be used to endorse or promote products
  23. #    derived from this software without specific prior written permission.
  24. #
  25. # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  26. # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  27. # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  28. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  29. # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  30. # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  31. # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  32. # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  33. # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  34. # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35. #
  36. #    $Id: strace-graph,v 1.2 1999/08/30 23:26:53 wichert Exp $
  37.  
  38. my %unfinished;
  39.  
  40. # Scales for strace slowdown.  Make configurable!
  41. my $scale_factor = 3.5;
  42.  
  43. while (<>) {
  44.     my ($pid, $call, $args, $result, $time);
  45.     chop;
  46.  
  47.     s/^(\d+)\s+//;
  48.     $pid = $1;
  49.  
  50.     if (s/^(\d\d):(\d\d):(\d\d)(?:\.(\d\d\d\d\d\d))? //) {
  51.     $time = $1 * 3600 + $2 * 60 + $3;
  52.     if (defined $4) {
  53.         $time = $time + $4 / 1000000;
  54.         $floatform = 1;
  55.     }
  56.     } elsif (s/^(\d+)\.(\d\d\d\d\d\d) //) {
  57.     $time = $1 + ($2 / 1000000);
  58.     $floatform = 1;
  59.     }
  60.  
  61.     if (s/ <unfinished ...>$//) {
  62.     $unfinished{$pid} = $_;
  63.     next;
  64.     }
  65.  
  66.     if (s/^<... \S+ resumed> //) {
  67.     unless (exists $unfinished{$pid}) {
  68.         print STDERR "$0: $ARGV: cannot find start of resumed call on line $.";
  69.         next;
  70.     }
  71.     $_ = $unfinished{$pid} . $_;
  72.     delete $unfinished{$pid};
  73.     }
  74.  
  75.     if (/^--- SIG(\S+) \(.*\) ---$/) {
  76.     # $pid received signal $1
  77.     # currently we don't do anything with this
  78.     next;
  79.     }
  80.  
  81.     if (/^\+\+\+ killed by SIG(\S+) \+\+\+$/) {
  82.     # $pid received signal $1
  83.     handle_killed($pid, $time);
  84.     next;
  85.     }
  86.  
  87.     ($call, $args, $result) = /(\S+)\((.*)\)\s+= (.*)$/;
  88.     unless (defined $result) {
  89.     print STDERR "$0: $ARGV: $.: cannot parse line.\n";
  90.     next;
  91.     }
  92.  
  93.     handle_trace($pid, $call, $args, $result, $time);
  94. }
  95.  
  96. display_trace();
  97.  
  98. exit 0;
  99.  
  100. sub parse_str {
  101.     my ($in) = @_;
  102.     my $result = "";
  103.  
  104.     while (1) {
  105.     if ($in =~ s/^\\(.)//) {
  106.         $result .= $1;
  107.     } elsif ($in =~ s/^\"//) {
  108.         if ($in =~ s/^\.\.\.//) {
  109.         return ("$result...", $in);
  110.         }
  111.         return ($result, $in);
  112.     } elsif ($in =~ s/([^\\\"]*)//) {
  113.         $result .= $1;
  114.     } else {
  115.         return (undef, $in);
  116.     }
  117.     }
  118. }    
  119.  
  120. sub parse_one {
  121.     my ($in) = @_;
  122.  
  123.     if ($in =~ s/^\"//) {
  124.     ($tmp, $in) = parse_str($in);
  125.     if (not defined $tmp) {
  126.         print STDERR "$0: $ARGV: $.: cannot parse string.\n";
  127.         return (undef, $in);
  128.     }
  129.     return ($tmp, $in);
  130.     } elsif ($in =~ s/^0x(\x+)//) {
  131.     return (hex $1, $in);
  132.     } elsif ($in =~ s/^(\d+)//) {
  133.     return (int $1, $in);
  134.     } else {
  135.     print STDERR "$0: $ARGV: $.: unrecognized element.\n";
  136.     return (undef, $in);
  137.     }
  138. }
  139.  
  140. sub parseargs {
  141.     my ($in) = @_;
  142.     my @args = ();
  143.     my $tmp;
  144.  
  145.     while (length $in) {
  146.     if ($in =~ s/^\[//) {
  147.         my @subarr = ();
  148.         if ($in =~ s,^/\* (\d+) vars \*/\],,) {
  149.         push @args, $1;
  150.         } else {
  151.         while ($in !~ s/^\]//) {
  152.             ($tmp, $in) = parse_one($in);
  153.             defined $tmp or return undef;
  154.             push @subarr, $tmp;
  155.             unless ($in =~ /^\]/ or $in =~ s/^, //) {
  156.             print STDERR "$0: $ARGV: $.: missing comma in array.\n";
  157.             return undef;
  158.             }
  159.             if ($in =~ s/^\.\.\.//) {
  160.             push @subarr, "...";
  161.             }
  162.         }
  163.         push @args, \@subarr;
  164.         }
  165.     } elsif ($in =~ s/^\{//) {
  166.         my %subhash = ();
  167.         while ($in !~ s/^\}//) {
  168.         my $key;
  169.         unless ($in =~ s/^(\w+)=//) {
  170.             print STDERR "$0: $ARGV: $.: struct field expected.\n";
  171.             return undef;
  172.         }
  173.         $key = $1;
  174.         ($tmp, $in) = parse_one($in);
  175.         defined $tmp or return undef;
  176.         $subhash{$key} = $tmp;
  177.         unless ($in =~ s/, //) {
  178.             print STDERR "$0: $ARGV: $.: missing comma in struct.\n";
  179.             return undef;
  180.         }
  181.         }
  182.         push @args, \%subhash;
  183.     } else {
  184.         ($tmp, $in) = parse_one($in);
  185.         defined $tmp or return undef;
  186.         push @args, $tmp;
  187.     }
  188.     unless (length($in) == 0 or $in =~ s/^, //) {
  189.         print STDERR "$0: $ARGV: $.: missing comma.\n";
  190.         return undef;
  191.     }        
  192.     }
  193.     return @args;
  194. }
  195.         
  196.  
  197. my $depth = "";
  198.  
  199. # process info, indexed by pid.
  200. # fields: 
  201. #    parent         pid number
  202. #    seq            forks and execs for this pid, in sequence  (array)
  203.  
  204. #  filename and argv (from latest exec)
  205. #  basename (derived from filename)
  206. # argv[0] is modified to add the basename if it differs from the 0th argument.
  207.  
  208. my %pr;
  209.  
  210. sub handle_trace {
  211.     my ($pid, $call, $args, $result, $time) = @_;
  212.     my $p;
  213.  
  214.     if (defined $time and not defined $pr{$pid}{start}) {
  215.     $pr{$pid}{start} = $time;
  216.     }
  217.  
  218.     if ($call eq 'execve') {
  219.     return if $result != 0;
  220.  
  221.     my ($filename, $argv) = parseargs($args);
  222.     ($basename) = $filename =~ m/([^\/]*)$/;
  223.     if ($basename ne $$argv[0]) {
  224.         $$argv[0] = "$basename($$argv[0])";
  225.         }
  226.     my $seq = $pr{$pid}{seq};
  227.     $seq = [] if not defined $seq;
  228.  
  229.     push @$seq, ['EXEC', $filename, $argv];
  230.  
  231.     $pr{$pid}{seq} = $seq;
  232.     } elsif ($call eq 'fork') {
  233.     return if $result == 0;
  234.  
  235.     my $seq = $pr{$pid}{seq};
  236.     $seq = [] if not defined $seq;
  237.     push @$seq, ['FORK', $result];
  238.     $pr{$pid}{seq} = $seq;
  239.     $pr{$result}{parent} = $pid;
  240.     } elsif ($call eq '_exit') {
  241.     $pr{$pid}{end} = $time if defined $time;
  242.     }
  243. }
  244.  
  245. sub handle_killed {
  246.     my ($pid, $time) = @_;
  247.     $pr{$pid}{end} = $time if defined $time;
  248. }
  249.  
  250. sub straight_seq {
  251.     my ($pid) = @_;
  252.     my $seq = $pr{$pid}{seq};
  253.  
  254.     for $elem (@$seq) {
  255.     if ($$elem[0] eq 'EXEC') {
  256.         my $argv = $$elem[2];
  257.         print "$$elem[0] $$elem[1] @$argv\n";
  258.     } elsif ($$elem[0] eq 'FORK') {
  259.         print "$$elem[0] $$elem[1]\n";
  260.     } else {
  261.         print "$$elem[0]\n";
  262.     }
  263.     }
  264. }
  265.  
  266. sub first_exec {
  267.     my ($pid) = @_;
  268.     my $seq = $pr{$pid}{seq};
  269.  
  270.     for $elem (@$seq) {
  271.     if ($$elem[0] eq 'EXEC') {
  272.         return $elem;
  273.     }
  274.     }
  275.     return undef;
  276. }
  277.  
  278. sub display_pid_trace {
  279.     my ($pid, $lead) = @_;
  280.     my $i = 0;
  281.     my @seq = @{$pr{$pid}{seq}};
  282.     my $elapsed;
  283.  
  284.     if (not defined first_exec($pid)) {
  285.     unshift @seq, ['EXEC', '', ['(anon)'] ];
  286.     }
  287.  
  288.     if (defined $pr{$pid}{start} and defined $pr{$pid}{end}) {
  289.     $elapsed = $pr{$pid}{end} - $pr{$pid}{start};
  290.     $elapsed /= $scale_factor;
  291.     if ($floatform) {
  292.         $elapsed = sprintf("%0.02f", $elapsed);
  293.     } else {
  294.         $elapsed = int $elapsed;
  295.     }
  296.     }
  297.  
  298.     for $elem (@seq) {
  299.     $i++;
  300.     if ($$elem[0] eq 'EXEC') {
  301.         my $argv = $$elem[2];
  302.         if (defined $elapsed) {
  303.         print "$lead [$elapsed] @$argv\n";
  304.         undef $elapsed;
  305.         } else {
  306.         print "$lead @$argv\n";
  307.         }
  308.     } elsif ($$elem[0] eq 'FORK') {
  309.         if ($i == 1) {
  310.                 if ($lead =~ /-$/) {
  311.              display_pid_trace($$elem[1], "$lead--+--");
  312.                 } else {
  313.              display_pid_trace($$elem[1], "$lead  +--");
  314.                 }
  315.         } elsif ($i == @seq) {
  316.         display_pid_trace($$elem[1], "$lead  `--");
  317.         } else {
  318.         display_pid_trace($$elem[1], "$lead  +--");
  319.         }
  320.     }
  321.     if ($i == 1) {
  322.         $lead =~ s/\`--/   /g;
  323.         $lead =~ s/-/ /g;
  324.         $lead =~ s/\+/|/g;
  325.     }
  326.     }
  327. }
  328.  
  329. sub display_trace {
  330.     my ($startpid) = @_;
  331.  
  332.     $startpid = (keys %pr)[0];
  333.     while ($pr{$startpid}{parent}) {
  334.     $startpid = $pr{$startpid}{parent};
  335.     }
  336.  
  337.     display_pid_trace($startpid, "");
  338. }
  339.     
  340.